( pure assembly macros )

: getword ( x|a mode offset --  x'|a' )
  swap # = if $8 * >> else + then ;

: -mbounds ( width -- stop start )
  msize negate
  swap msize - ;

: +mbounds ( width -- stop start )
  $0 ;

: -xbounds ( width -- stop start )
  xsize negate
  swap xsize - ;

: +xbounds ( width -- stop start )
  $0 ;

: push. ( src srcmode offset -- src srcmode )
  >r 2dup r> getword
  over dup case
    #  of pea, endof
    @d of pei, endof
    -rot lda, pha,
  endcase ;

: push ( src srcmode width -- )
  -mbounds ?do i push. msize -loop 2drop ;

: push2 ( src srcmode -- ) $2 push ;
: push4 ( src srcmode -- ) $4 push ;
: push8 ( src srcmode -- ) $8 push ;

: pull. ( dest destmode offset -- )
  pla, >r 2dup r> getword over sta, ;

: pull ( dest destmode width -- )
  +mbounds ?do i pull. msize +loop 2drop ;

: pull2 ( dest destmode -- ) $2 pull ;
: pull4 ( dest destmode -- ) $4 pull ;
: pull8 ( dest destmode -- ) $8 pull ;

: ypush. ( src srcmode offset -- )
  >r 2dup r> getword over ldy, phy, ;

: ypush ( src srcmode width -- )
  -xbounds ?do i ypush. xsize -loop 2drop ;

: ypush2 ( src srcmode -- ) $2 ypush ;
: ypush4 ( src srcmode -- ) $4 ypush ;
: ypush8 ( src srcmode -- ) $8 ypush ;

: ypull. ( dest destmode offset -- )
  ply, >r 2dup r> getword over sty, ;

: ypull ( dest destmode width -- )
  +xbounds ?do i ypull. xsize +loop 2drop ;

: ypull2 ( dest destmode -- ) $2 ypull ;
: ypull4 ( dest destmode -- ) $4 ypull ;
: ypull8 ( dest destmode -- ) $8 ypull ;

: move. ( src srcmode dest destmode offset -- src srcmode dest destmode )
  >r
  2swap 2dup r@ getword over lda,
  2swap 2dup r> getword over sta, ;

: move' ( src srcmode dest destmode width -- )
  +mbounds ?do i move. msize +loop 2drop 2drop ;

: move2 ( src srcmode dest destmode -- ) $2 move' ;
: move4 ( src srcmode dest destmode -- ) $4 move' ;
: move8 ( src srcmode dest destmode -- ) $8 move' ;

: #push4a
  dup ta>offset $10 >> # lda, pha, there 3 - over rel2h
  dup ta>offset        # lda, pha, there 3 - swap rel2l ;

: #move4a ( ta dest destmode -- )
  rot dup ta>offset        # lda, there 2 - over rel2l -rot 2dup $0 getword over sta,
  rot dup ta>offset $10 >> # lda, there 2 - over rel2h -rot 2dup $2 getword over sta,
  2drop drop ;

: add. ( src1 src1mode src2 src2mode dest destmode offset -- )
  >r
  2rot 2dup r@ getword over lda,
  2rot 2dup r@ getword over adc,
  2rot 2dup r> getword over sta, ;

: add' ( src1 src1mode src2 src2mode dest destmode width -- )
  clc,
  +mbounds ?do i add. msize +loop 2drop 2drop 2drop ;

: add2 ( src1 src1mode src2 src2mode dest destmode -- ) $2 add' ;
: add4 ( src1 src1mode src2 src2mode dest destmode -- ) $4 add' ;
: add8 ( src1 src1mode src2 src2mode dest destmode -- ) $8 add' ;

: sub. ( src1 src1mode src2 src2mode dest destmode offset -- )
  >r
  2rot 2dup r@ getword over lda,
  2rot 2dup r@ getword over sbc,
  2rot 2dup r> getword over sta, ;

: sub' ( src1 src1mode src2 src2mode dest destmode width -- )
  sec,
  +mbounds ?do i sub. msize +loop 2drop 2drop 2drop ;

: sub2 ( src1 src1mode src2 src2mode dest destmode -- ) $2 sub' ;
: sub4 ( src1 src1mode src2 src2mode dest destmode -- ) $4 sub' ;
: sub8 ( src1 src1mode src2 src2mode dest destmode -- ) $8 sub' ;

: fcmp. ( src1 src1mode src2 src2mode offset -- )
  >r
  2swap 2dup r@ getword over lda,
  2swap 2dup r> getword over sbc, ;

: fcmp' ( src1 src1mode src2 src2mode width -- )
  sec,
  +mbounds ?do i fcmp. msize +loop 2drop 2drop ;

: fcmp2 ( src1 src1mode src2 src2mode -- ) $2 fcmp' ;
: fcmp4 ( src1 src1mode src2 src2mode -- ) $4 fcmp' ;
: fcmp8 ( src1 src1mode src2 src2mode -- ) $8 fcmp' ;

: 0fcmp' ( src1 src1mode src2 src2mode width -- )
  clc,
  +mbounds ?do i fcmp. msize +loop 2drop 2drop ;

: 0fcmp2 ( src1 src1mode src2 src2mode -- ) $2 0fcmp' ;
: 0fcmp4 ( src1 src1mode src2 src2mode -- ) $4 0fcmp' ;
: 0fcmp8 ( src1 src1mode src2 src2mode -- ) $8 0fcmp' ;

: cmp. ( src1 src1mode src2 src2mode offset -- )
  >r
  2swap 2dup r@ getword over lda,
  2swap 2dup r> getword over cmp, ;

: cmp2 ( src1 src1mode src2 src2mode -- )
  $0 cmp.
  2drop 2drop ;

: cmp4 ( src1 src1mode src2 src2mode -- )
  $2 cmp. zero if,
    >r $0 cmp. r>
  then,
  2drop 2drop ;

: cmp8 ( src1 src1mode src2 src2mode -- )
  $6 cmp. zero if,
    >r $4 cmp. r> zero if,
      >r >r $2 cmp. r> r> zero if,
        >r >r >r $0 cmp. r> r> r>
      then,
    then,
  then,
  2drop 2drop ;

: stack+ ( n -- )
  tsc,
  clc,
  # adc,
  tcs, ;

: stack- ( n -- )
  tsc,
  sec,
  # sbc,
  tcs, ;

: dfetch4 ( src dest destmode -- )
               rot dup [d]   lda, -rot 2dup $0 getword over sta,
  $0002 # ldy, rot dup [d],y lda, -rot 2dup $2 getword over sta,
  2drop drop ;

: add4push ( src1 src1mode src2 src2mode -- )
  clc,
  2swap 2dup $0 getword over lda, 2swap 2dup $0 getword over adc, tay,
  2swap 2dup $2 getword over lda, 2swap 2dup $2 getword over adc, pha, phy,
  2drop 2drop ;

: emulation ( -- )
  sec,
  xce,
  mbit xbit or short ;

: native ( -- )
  clc,
  xce, ;

( forward jump )

: jmpfrom ( mode -- )
  case
    @a    of $3 tallot endof
    @al   of $4 tallot endof
    (a)   of $3 tallot endof
    (a,x) of $3 tallot endof
    true abort" unsupported mode"
  endcase ;

: jmphere ( ta mode -- )
  there >r
  swap torg
  r@ swap jmp,
  r> torg ;

